Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Pascal/Applications/NIH Image 1.55/Macros/Measurement Macros

Text File | 1994-04-11 | 13.3 KB | 622 lines | [TEXT/Imag]

macro 'Particle Analysis Test';
var
  x,y,rows,columns,maxradius,radius:integer;
begin
  SaveState;
  rows:=5; columns:=5;
  maxradius:=rows*columns;
  SetForegroundColor(255);
  SetBackgroundColor(0);
  SetNewSize(columns*maxradius*2+20,rows*maxradius*2+20);
  MakeNewWindow('Objects');
  radius:=1;
  for y:=0 to columns-1 do
    for x:=0 to rows-1 do begin
      MakeOvalRoi(x*maxradius*2+10,y*maxradius*2+10,radius*2,radius*2);
      Fill;
      radius:=radius+1;
    end;
  KillRoi;
  SetParticleSize(1,9999);
  LabelParticles(true);
  OutlineParticles(true);
  SetOptions('Area, Perimeter, Major, Minor');
  AnalyzeParticles;
  SetUser1Label('Perim.d');
  SetUser2Label('Area');
  for radius:=1 to maxradius do begin
    rUser1[radius]:=2*3.14159*radius;
    rUser2[radius]:=3.14159*sqr(radius);
  end;
  ShowResults;
  RestoreState;
end;


macro 'Count Particles at Random Locations';
var
  n,i,width,height,PicID,nLocations:integer;
  size:real;
begin
  RequiresVersion(1.44);
  nLocations:=10;
  size:=0.25;
  n:=1;
  GetPicSize(width,height);
  PicID:=PicNumber;
  SetUser1Label('Count');
  SetOptions('User1');
  for i:=1 to nLocations do begin
    SelectPic(PicID);
    MakeRoi((1-size)*width*random,(1-size)*height*random,size*width,size*height);
    Duplicate('Temp');;
    SetDensitySlice(255,255);
    AnalyzeParticles;
    Dispose;
    rUser1[i]:=rCount;
  end;
  KillRoi;
  SetCounter(nLocations);
  ShowResults;
end;


macro 'Make Circle from Line';
var
  x1,x2,y1,y2,top,left,width,height:integer;
  xcenter,ycenter,radius:integer;
begin
  GetLine(x1,y1,x2,y2,width);
  if x1<0 then begin
    PutMessage('This macro requires a line selection.');
    exit;
  end;
  xcenter:=x1+(x2-x1)/2;
  ycenter:=y1+(y2-y1)/2;
  radius:=sqrt(sqr(x2-x1)+sqr(y2-y1))/2;
  MakeOvalROI(xcenter-radius,ycenter-radius,radius*2,radius*2);
end;


macro 'Display Calibration Table';
{
Stores 0-255(all possible gray values) in the User1 column
and the 256 corresponding calibrated values in the User2 column.
Max Measurements must be set to 256 or greater. Use the Export
command to export the calibration table to a text file. The two
columns will be identical if the image is not calibrated.
}
var
  i:integer;
  v:real;
begin
  RequiresVersion(1.44);
  SetCounter(256);
  SetUser1Label('value');
  SetUser2Label('cvalue');
  for i:=0 to 255 do begin
    rUser1[i+1]:=i;
    rUser2[i+1]:=cvalue(i);
  end;
  ShowResults;
end;


macro 'Measure and draw line [L]';
var
  x1,x2,y1,y2,width:integer;
begin
  GetLine(x1,y1,x2,y2,width);
  if x1<0 then begin
    PutMessage('This macro requires a straight line selection.');
    exit;
  end;
  Measure;
  Fill;
  KillRoi;
end;

macro 'Measure and Outline [M]';
begin
  Measure;
  DrawBoundary;
  DrawBoundary;
end;


macro 'Measure All';
{Measures all currently open images using the current selection. There is}
{an implied "Select All" if the active image doesn't have a selection.}
var
  i,left,top,width,height:integer;
begin
  ResetCounter;
  for i:=1 to nPics do begin
    SelectPic(i);
    RestoreROI;
    Measure;
  end;
end;


macro 'Measure All from Disk';
{
Reads from disk and measures a set of images too large to simultaneously
fit in memory. The image names names must be in the form '01', '02', etc.
Before starting, open and outline the first image('01').
}
var
  i,width,height:integer;
begin
  GetPicSize(width,height);
  if width=0 then begin
    PutMessage('Before running this macro, open and outline the first image("01") in the series.');
    exit;
  end;
  ResetCounters;
  Measure;
  close;
  for i:=2 to 1000 do begin
    open(i:2);
    RestoreROI;
    Measure;
    close;
  end;
end;


macro 'Paste Results'
{Use the Measure command, the ruler tool, or the pointing tool to}
{make up to about 10 measurements, then use this macro to paste}
{the results into the upper left corner of the window.}
begin
  SetFont('Monaco');
  SetFontSize(9);
  SetText('Plain; Align Left');
  SetOption; {Copy headings}
  CopyResults;
  MakeRoi(-10,0,250,150);
  Paste;
  KillRoi;
  ResetCounter;
end;


macro 'Measure Redirected and Label'
begin
  Redirect(true);
  Measure;
  Redirect(false);
  MarkSelection;
  RestoreRoi;
end;


macro 'Reset Measurement Options';
{Resets the Options dialog box in the Analyze menu to the default settings.}
begin
  RequiresVersion(1.44);
  SetOptions('Area; Mean');
  Redirect(false);
  LabelParticles(true);
  OutlineParticles(false);
  IgnoreParticlesTouchingEdge(false);
  IncludeInteriorHoles(false);
  WandAutoMeasure(false);
  AdjustAreas(false);
  SetParticleSize(1,999999);
  SetPrecision(2);
end;


macro 'Set Threshold…';
var
  lower,upper:integer;
begin
  lower:=GetNumber('Lower:',1);
  upper:=GetNumber('Upper:',254);
  SetDensitySlice(lower,upper);
end;


macro 'Measure Accumulated Perimeter[A]';
{
Measures perimeter and computes accumulated perimeter,
storing it in the User1 column.
}
var
  i:integer;
  Total:real;
begin
  SetOptions('Area; Mean; Perimeter; User1');
  SetUser1Label('Total');
  Measure;
  Total:=0;
  for i:=1 to rCount do Total:=Total+rLength[i];
  rUser1[rCount]:=Total;
  UpdateResults;
end;


macro 'Count Black and White Pixels [B]';
{
Counts the number of black and white pixels in the current
selection and stores the counts in the User1 and User2 columns.
}
begin
  RequiresVersion(1.44);
  SetUser1Label('Black');
  SetUser2Label('White');
  Measure;
  rUser1[rCount]:=histogram[255];
  rUser2[rCount]:=histogram[0];
  UpdateResults;
end;


macro 'Compute Percent Black and White';
{
Computes the percentage of back and white pixels in the
current selection. This macro only works with binary images.
}
var
  nPixels,mean,mode,min,max:real;
begin
  RequiresVersion(1.44);
  SetUser1Label('Black');
  SetUser2Label('White');
  Measure;
  GetResults(nPixels,mean,mode,min,max);
  rUser1[rCount]:=histogram[255]/nPixels;
  rUser2[rCount]:=histogram[0]/nPixels;
  UpdateResults;
  if (histogram[0]+histogram[255])<>nPixels
    then PutMessage('This macro requires a binary image.');
end;


macro 'Compute Area Percentage [P]';
{
Computes the percentage of foreground
pixels in the current selection.
}
var
  mean,mode,min,max:real;
  i,lower,upper,fPixels,nPixels,count:integer;
begin
  RequiresVersion(1.50);
  SetUser1Label('%');
  Measure;
  GetResults(nPixels,mean,mode,min,max);
  GetThresholds(lower,upper);
  if (lower=0) and (upper=0) and
     ((histogram[0]+histogram[255])<>nPixels)
     then begin
       PutMessage('This macro requires a binary or thresholded image.');
       exit;
     end;
  if nPixels=0 then begin
  end;
  if (lower=0) and (upper=0) then begin
    if nPixels=0
      then rUser1[rCount]:=0
      else rUser1[rCount]:=(histogram[255]/nPixels)*100;
    UpdateResults;
    exit;
  end;
  fPixels:=0;
  nPixels:=0;
  for i:=0 to 255 do begin
    count:=histogram[i];
    nPixels:=nPixels+count;
    if (i>=lower) and (i<=upper)
      then fPixels:=fPixels+count;
  end;
  rUser1[rCount]:=(fPixels/nPixels)*100;
  UpdateResults;
end;


macro 'Compute Average and Total Area [T]';
{
Computes average and accumulated area and stores
the them in the Major and Minor Axis columns.
}
var
  i:integer;
  sum:real;
begin
  RequiresVersion(1.44);
  SetUser1Label('Avg');
  SetUser2Label('Total');
  SetOptions('Area; User1; User2');
  Measure;
  sum:=0;
  for i:=1 to rCount do sum:=sum+rArea[i];
  rUser1[rCount]:=sum/rCount;
  rUser2[rCount]:=sum;
  UpdateResults;
end;


macro 'Measure Circularity';
begin
  SetUser1Label('Shape');
  Measure;
  rUser1[rCount]:=4*3.14159265*(rArea[rCount]/sqr(rLength[rCount]));
  UpdateResults;
end;


macro 'Measure Mean * Area';
begin
  SetUser1Label('Mean*Area');
  Measure;
  rUser1[rCount]:=rMean[rCount]*rArea[rCount];
  UpdateResults;
end;


macro 'Draw Fitted Ellipse in White';
var
  left,top,width,height:real;
begin
  GetRoi(left,top,width,height);
  if width=0 then begin
    PutMessage('This macro requires a selection.');
    exit;
  end;
  SetOptions('Area; Mean; X-Y Center');
  Measure;
  SetOption; MarkSelection;
  KillRoi;
  SelectAll;
  KillRoi;
 end;

macro 'Draw XY Center';
var
  left,top,width,height,x,y:real;
begin
  RequiresVersion(1.44);
  GetRoi(left,top,width,height);
  if width=0 then begin
    PutMessage('This macro requires a selection.');
    exit;
  end;
  SaveState; {Invert Y status saved starting with V1.44b21}
  InvertY(false);
  SetForegroundColor(255); {black}
  SetOptions('Area; Mean; X-Y Center'); {XY Center}
  Measure;
  KillRoi;
  x:=rX[rCount];
  y:=rY[rCount];
  MoveTo(x-5,y);
  LineTo(x+5,y);
  MoveTo(x,y-5);
  LineTo(x,y+5);
  RestoreState;
end;




macro 'Compute Spatial Scale';
var
  scale:real;
begin
  MakeLineRoi(0,0,100,0);
  Measure;
  KillRoi;
  Scale:=100/rLength[rCount];
  if scale=1
    then PutMessage('Image is not spatially calibrated')
    else PutMessage('Scale=',scale:1:4,' pixels/unit');
end;


procedure StoreZeros;
begin
  Measure;
  rArea[rCount]:=0;
  rMean[rCount]:=0;
  rStdDev[rCount]:=0;
  rX[rCount]:=0;
  rY[rCount]:=0;
  rLength[rCount]:=0;
  rMajor[rCount]:=0;
  rMinor[rCount]:=0;
  rAngle[rCount]:=0;
  rUser1[rCount]:=0;
  rUser2[rCount]:=0;
  UpdateResults;
end;

macro 'Store Break in Results [S]';
{Stores a row of zeros in the results table.}
begin
  StoreZeros;
end;

macro 'Compute Means';
var
  n,i:integer;
begin
  n:=rCount;
  StoreZeros;
  StoreZeros;
  for i:=1 to n do begin
    rArea[rCount]:=rArea[rCount]+rArea[i];
    rMean[rCount]:=rMean[rCount]+rMean[i];
    rStdDev[rCount]:=rStdDev[rCount]+rStdDev[i];
    rX[rCount]:=rX[rCount]+rX[i];
    rY[rCount]:=rY[rCount]+rY[i];
    rLength[rCount]:=rLength[rCount]+rLength[i];
    rMajor[rCount]:=rMajor[rCount]+rMajor[i];
    rMinor[rCount]:=rMinor[rCount]+rMinor[i];
    rAngle[rCount]:=rAngle[rCount]+rAngle[i];
    rUser1[rCount]:=rUser1[rCount]+rUser1[i];
    rUser2[rCount]:=rUser2[rCount]+rUser2[i];
  end;
  rArea[rCount]:=rArea[rCount]/n;
  rMean[rCount]:=rMean[rCount]/n;
  rStdDev[rCount]:=rStdDev[rCount]/n;
  rX[rCount]:=rX[rCount]/n;
  rY[rCount]:=rY[rCount]/n;
  rLength[rCount]:=rLength[rCount]/n;
  rMajor[rCount]:=rMajor[rCount]/n;
  rMinor[rCount]:=rMinor[rCount]/n;
  rAngle[rCount]:=rAngle[rCount]/n;
  rUser1[rCount]:=rUser1[rCount]/n;
  rUser2[rCount]:=rUser2[rCount]/n;
  UpdateResults;
end;

macro 'Measure both Raw and Calibrated';
{
This macro is a variation of the Measure command that displays the number
of pixels in User1 and uncalibrated(raw) mean density in User2. It takes
advantage of the fact that GetResults always returns uncalibrated values.
}
var
  nPixels,mean,mode,min,max:real;
begin
  SetUser1Label('Pixels');
  SetUser2Labe2('Raw Mean');
  Measure;
  GetResults(nPixels,mean,mode,min,max);
  rUser1[rCount]:=nPixels;
  rUser2[rCount]:=mean;
  UpdateResults;
end;


macro 'Mark Centers';
{Replaces each object in the image with a single pixel.}
var i:integer;
begin
   Duplicate('Center');
   SetScale(0,'pixels');
   AutoThreshold;
   AnalyzeParticles;
   SelectAll;
   Clear;
   For i:=1 to rCount do
      PutPixel(rX[i],rY[i],255);
end;

macro 'Density Slice [D]';
var
  t1,t2:integer;
begin
  GetThresholds(t1,t2);
  if (t1=0) and (t2=0)
    then SetDensitySlice(255,255)
    else SetDensitySlice(0,0);
end;

macro 'Set Scale and Aspect Ratio';
{
Sets the spatial scale and aspect ratio to predefined
values contained in an image names "scale". This image
can be very small, say 20x10. The directory (folder) path
in the open statement will probably have to be changed.
}
begin
  open('hd400:image:scale');
  PropagateSpatial;
  Dispose;
end;

macro 'Save Results to Text File…';
{This is an example of how to save results to a text file.}
begin
  Measure;
  NewTextWindow('My Results');
  writeln('Area=',rArea[rCount]:1:3);
  writeln('Mean=',rMean[rCount]:1:3);
  SaveAs;
end;

macro 'Find Radial Distances';
{Finds center to edge distances along radial lines and displays them in User1.}
var
  RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  x1,y1,x2,y2,count,ppv:integer;
  pi,angle,delta,min,max,scale:real;
  line,i,nLines,radius,r:integer;
  unit:string;
begin
  RequiresVersion(1.55);
  SaveState;
  GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  if RoiWidth=0 then begin
    PutMessage('Selection Required.');
    exit;
  end;
  GetScale(scale,unit);
  MoveRoi(-RoiLeft,-RoiTop);
  KillRoi;
  RestoreRoi;
  SetForegroundColor(255);
  SetBackgroundColor(0);
  SetNewSize(RoiWidth,RoiHeight);
  MakeNewWindow('Temp');
  RestoreRoi;
  SetOptions('X-Y Center');
  Measure;
  DrawBoundary;
  KillRoi;
  x1:=rX[rCount]*scale;
  y1:=rY[rCount]*scale;
  radius:=sqrt(sqr(x1)+sqr(y1));
  r:=sqrt(sqr(RoiWidth-x1)+sqr(y1));
  if r>radius then radius:=r;
  r:=sqrt(sqr(RoiWidth-x1)+sqr(RoiHeight-y1));
  if r>radius then radius:=r;
  r:=sqrt(sqr(x1)+sqr(RoiHeight-y1));
  if r>radius then radius:=r;
  nLines:=GetNumber('Number of Radial Lines:',36);
  pi:=3.14159;
  delta:=2.0*pi/nLines;
  angle:=0.0;
  ResetCounter;
  SetUser1Label('Dist.');
  SetOptions('User1');
  for line:=1 TO nLines do begin
    x2:=x1+round(radius*cos(angle));
    y2:=y1+round(radius*sin(angle));
    MakeLineRoi(x1,y1,x2,y2);
    GetPlotData(count,ppv,min,max);
    Fill;
    i:=count;
    repeat
      i:=i-1;
    until (i<=0) or (PlotData[i]>0);
    rUser1[line]:=i;
    angle:=angle+delta;
  end;
  KillRoi;
  if scale<>1 then
    for i:=1 to nLines do rUser1[i]:=rUser1[i]/scale;
  SetCounter(nLines);
  RestoreState;
  ShowResults;
end;

Macro 'Copy Results to Clipboard with Headers';
begin
  SelectWindow('Results');
  SetOption; Copy;
end;

Macro 'Export Results with Headers';
begin
  SetExport('Measurements');
  SetOption; Export('HD80:Image:Results');
end;